home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok03.lha / IFFLoad_1.1 / DiaShow.mod < prev    next >
Text File  |  1993-08-15  |  4KB  |  133 lines

  1. (*---------------------------------------------------------------------------
  2.     :Program.    ShowIFF.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Phone.      0711/822509
  6.     :Shortcut.   [fbs]
  7.     :Version.    1.0
  8.     :Date.       20.04.88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    IFFLoad [fbs].
  13.     :UpDate.     none.
  14.     :Contents.   IFF-Ladeprogramm zum Betrachten von IFF (ILBM)-Bildern.
  15.     :Remark.     Wieso kann M&T die Compression nicht erklären ???
  16. ---------------------------------------------------------------------------*)
  17. MODULE DiaShow;
  18.  
  19. FROM SYSTEM IMPORT ADR, CAST, SHIFT, BITSET;
  20.  
  21. FROM Intuition IMPORT ScreenPtr,ScreenToFront,CloseScreen,CurrentTime,
  22.        WindowPtr;
  23. FROM Graphics IMPORT WaitTOF,LoadRGB4,SetRGB4,ViewModes;
  24.  
  25. FROM Arguments IMPORT NumArgs,GetArg;
  26. FROM Conversions IMPORT StrToVal;
  27.  
  28. FROM IFFLoad IMPORT ReadILBM,ReadILBMFlags,ReadILBMFlagSet,IFFInfoTypePtr,
  29.        IFFInfoType,IFFInfo;
  30.  
  31. VAR
  32.   Screen1,Screen2: ScreenPtr;
  33.   WindowDummy: WindowPtr;
  34.   Info1,Info2: IFFInfoType;
  35.   Name: ARRAY[0..79] OF CHAR;
  36.   length: INTEGER;
  37.   i,j: CARDINAL;
  38.   ok,Error: BOOLEAN;
  39.   Seconds,Micros: LONGINT;
  40.   SecondsToWait,Secs: LONGINT;
  41.   LastSeconds: LONGINT;
  42.   Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  43.   n,m: CARDINAL;
  44.  
  45. PROCEDURE DimOff(Screen: ScreenPtr; Info: IFFInfoTypePtr);
  46.  
  47. BEGIN
  48.   WITH Screen^ DO
  49.     IF NOT(ham IN viewPort.modes) THEN
  50.       WITH Info^.CMAP DO
  51.         FOR m:=15 TO 0 BY -1 DO
  52.           FOR n:=0 TO colorCnt-1 DO
  53.             SetRGB4(ADR(viewPort),n,SHIFT(red  [n]*m,-4),
  54.                                     SHIFT(green[n]*m,-4),
  55.                                     SHIFT(blue [n]*m,-4));
  56.           END;
  57.           WaitTOF;
  58.         END;
  59.       END;
  60.     END;
  61.   END;
  62. END DimOff;
  63.  
  64. PROCEDURE DimOn(Screen: ScreenPtr; Info: IFFInfoTypePtr);
  65.  
  66. VAR
  67.   front: BOOLEAN;
  68.  
  69. BEGIN
  70.   front := FALSE;
  71.   WITH Screen^ DO
  72.     IF NOT(ham IN viewPort.modes) THEN
  73.       WITH Info^.CMAP DO
  74.         FOR m:=1 TO 16 DO
  75.           FOR n:=0 TO colorCnt-1 DO
  76.             SetRGB4(ADR(viewPort),n,SHIFT(red  [n]*m,-4),
  77.                                     SHIFT(green[n]*m,-4),
  78.                                     SHIFT(blue [n]*m,-4));
  79.           END;
  80.           IF NOT(front) THEN
  81.             ScreenToFront(Screen);
  82.             front := TRUE;
  83.           END;
  84.           WaitTOF;
  85.         END;
  86.       END;
  87.     ELSE
  88.       ScreenToFront(Screen);
  89.     END;
  90.   END;
  91. END DimOn;
  92.  
  93. BEGIN
  94.   i := NumArgs();
  95.   j := 1;
  96.   Screen2 := NIL;
  97.   SecondsToWait := 20;
  98.   WHILE j<=i DO
  99.     GetArg(j,Name,length);
  100.     ok:=FALSE;
  101.     StrToVal(Name,Secs,ok,10,Error);
  102.     IF NOT(Error) THEN
  103.       SecondsToWait := Secs;
  104.     ELSE
  105.       IF ReadILBM(Name,ReadILBMFlagSet{visible},Screen1,WindowDummy) THEN
  106.         Info1 := IFFInfo;
  107.         IF Screen2#NIL THEN
  108.           REPEAT
  109.             CurrentTime(ADR(Seconds),ADR(Micros));
  110.           UNTIL (Seconds-SecondsToWait>=LastSeconds) OR NOT(lmb IN Ciapra);
  111.           DimOff(Screen2,ADR(Info2));
  112.         END;
  113.         DimOn(Screen1,ADR(Info1));
  114.         CurrentTime(ADR(Seconds),ADR(Micros));
  115.         LastSeconds := Seconds;
  116.         IF Screen2#NIL THEN CloseScreen(Screen2) END;
  117.         Screen2 := Screen1;
  118.         Info2 := Info1;
  119.       ELSE
  120.         Screen1 := NIL;
  121.       END;
  122.     END;
  123.     INC(j);
  124.   END;
  125.   IF Screen2#NIL THEN
  126.     REPEAT
  127.       CurrentTime(ADR(Seconds),ADR(Micros));
  128.     UNTIL (Seconds-SecondsToWait>=LastSeconds) OR NOT(lmb IN Ciapra);
  129.     DimOff(Screen2,ADR(Info2));
  130.     CloseScreen(Screen2);
  131.   END;
  132. END DiaShow.
  133.